
module Main where

import Data.IORef ( IORef, newIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import CPU
import ULA
import Barramento
import UnidadeControle
--import Nomes
import MicroInstrucoes

myInit :: IO ()
myInit = do		
	clearColor $= Color4 0 0 0 1	
	{-position (Light 0) $= Vertex4 0 0 0 1
	ambient (Light 0) $= Color4 1 1 1 1
	diffuse (Light 0) $= Color4 1 1 1 1
	specular (Light 0) $= Color4 1 1 1 1
	lighting $= Enabled
	light (Light 0) $= Enabled
	materialAmbient Front $= Color4 0 1 0 1
	materialDiffuse Front $= Color4 0 0 0 1
	materialSpecular Front $= Color4 1 1 1 1
	materialShininess Front $= 128-}
	--colorMaterial $= Just (Front, Ambient)
	--colorMaterial $= Just (Front, Diffuse)
	--colorMaterial $= Just (Front, Specular)
	blend $= Enabled
	blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
	shadeModel $= Smooth
	--depthFunc $= Just Less

display :: State -> DisplayCallback
display state = do
	clear [ ColorBuffer, DepthBuffer ]
	depthFunc $= Just Less
	aparece' <- get (aparece state)
	if (aparece' == 1) then do
	  	desenhaSimulador state
	 else do
	 	--lighting $= Disabled
	 	desenhaInicio state
	 	--lighting $= Enabled
	swapBuffers

desenhaInicio :: State -> IO ()
desenhaInicio state = do
	corI' <- get (corI state)
	textoI' <- get (textoI state)
	preservingMatrix $ do
		preservingMatrix $ do
			proporcao' <- get (proporcao state)
			escala' <- get (escala state)
			translate (Vector3 (- proporcao') proporcao' 0 :: Vector3 GLfloat)
			--scale 0.3 0.3 (0.3::GLfloat)
			scale escala' escala' (escala'::GLfloat)
			currentColor $= Color4 0 0 0 1
			renderQuadric (QuadricStyle Nothing NoTextureCoordinates Outside SilhouetteStyle)
							(Disk 0 20 40 1)		
			renderQuadric (QuadricStyle Nothing NoTextureCoordinates Outside SilhouetteStyle)
							(Disk 0 8 40 1)
			currentColor $= Color4 0 0.6 0 1
			tamUFPI' <- get (tamUFPI state)
			renderQuadric (QuadricStyle Nothing NoTextureCoordinates Outside LineStyle) 
							(PartialDisk 8 20 40 1 135 (fromIntegral tamUFPI'))
			if (textoI' >= 1) then do
				currentColor $= Color4 0 0.6 0 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
								translate (Vector3 (-3) (-3) 0 :: Vector3 GLfloat)
								scale 0.05 0.05 (0.05::GLfloat)
								renderString MonoRoman "UFPI"
			 else
			 	return ()
		if (textoI' >= 2) then do
			currentColor $= Color4 0 0.6 0 (realToFrac ((fromIntegral textoI') + corI'))
			preservingMatrix $ do
						translate (Vector3 (-27) 36 0 :: Vector3 GLfloat)
						scale 0.015 0.015 (0.015::GLfloat)
						renderString MonoRoman "Universidade Federal do Piaui"
			preservingMatrix $ do
						translate (Vector3 (-27) 32 0 :: Vector3 GLfloat)
						scale 0.015 0.015 (0.015::GLfloat)
						renderString MonoRoman "Departamento de Informatica e Estatistica"
		 else
		 	return ()
		if (textoI' >= 3) then do
					currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
					preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "S"
		 else
			return ()
		if (textoI' >= 4) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "Si"
		 else
			return ()
		if (textoI' >= 5) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "SiM"
		 else
			return ()
		if (textoI' >= 6) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "SiMi"
		 else
			return ()
		if (textoI' >= 7) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "SiMiA"
		 else
			return ()
		if (textoI' >= 8) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-32) 0 0 :: Vector3 GLfloat)
						scale 0.1 0.1 (0.1::GLfloat)
						renderString MonoRoman "SiMiAr"
		 else
			return ()
		if (textoI' >= 9) then do
				currentColor $= Color4 1 1 1 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 28 0 0 :: Vector3 GLfloat)
						scale 0.02 0.02 (0.02::GLfloat)
						renderString MonoRoman "2.0"
				preservingMatrix $ do
						translate (Vector3 (-29) (-8) 0 :: Vector3 GLfloat)
						scale 0.02 0.02 (0.02::GLfloat)
						renderString MonoRoman "Simulador de Micro Arquitetura"
		 else
			return ()
		if (textoI' >= 10) then do
				currentColor $= Color4 0 0.6 0 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-23) (-35) 0 :: Vector3 GLfloat)
						scale 0.015 0.015 (0.015::GLfloat)
						renderString MonoRoman "Jose Ricardo Mello Viana - Zezim"
		 else
			return ()
		if (textoI' >= 11) then do
				currentColor $= Color4 0 0.6 0 (realToFrac ((fromIntegral textoI') + corI'))
				preservingMatrix $ do
						translate (Vector3 (-10) (-38) 0 :: Vector3 GLfloat)
						scale 0.015 0.015 (0.015::GLfloat)
						renderString MonoRoman "Outubro de 2008"
		 else
			return ()
		currentColor $= Color4 1 1 1 (realToFrac corI')
		preservingMatrix $ do
				translate (Vector3 19 (-41) 0 :: Vector3 GLfloat)
				scale 0.01 0.01 (0.01::GLfloat)
				renderString MonoRoman "Aperte ESC para ir para o simulador"
		if (textoI' >= 100) then do
			aparece state $= 1
		 else
			return ()
		
desenhaSimulador :: State -> IO ()
desenhaSimulador state = do
	preservingMatrix $ do		
		x2' <- get (x2 state)
		y2' <- get (y2 state)
		z2' <- get (z2 state)
		translate (Vector3 (fromIntegral x2') (fromIntegral y2') (fromIntegral z2') :: Vector3 GLfloat)
		x <- get (eixox state)
		rotate (fromIntegral x :: GLfloat) (Vector3 1 0 0)		
		y <- get (eixoy state)
		rotate (fromIntegral y :: GLfloat) (Vector3 0 1 0)		
		z <- get (eixoz state)
		rotate (fromIntegral z :: GLfloat) (Vector3 0 0 1)		
		-- makes
		porc' <- get (porc state)
		cheios' <- get (cheios state)
		enchem' <- get (enchem state)
		mar' <- get (mar state)
		mdr' <- get (mdr state)
		pc' <- get (pc state)
		mbr' <- get (mbr state)
		sp' <- get (sp state)
		lv' <- get (lv state)
		cpp' <- get (cpp state)
		tos' <- get (tos state)
		opc' <- get (opc state)
		h' <- get (h state)
		desl' <- get (desl state)
		ula' <- get (ula state)
		lBar <- makeBarramento (Color4 1 1 1 0.5) cheios' enchem' porc'
		lUC <- makeUnidadeControle (Color4 1 1 0 0.5)
		lCPU <- makeCPU (Color4 0 1 0 0.5) 
				[mar', mdr', pc', mbr', sp', lv', cpp', tos', opc', h', desl']
		lUla <- makeUla (Color4 0 0 1 0.5) (20,-25) ula'
		--lNomes <- makeNomes
		-- callLists
		callList lBar
		callList lUC
		callList lCPU
		callList lUla
		--callList lNomes
		deleteObjectNames [lBar, lUC, lUla, {-lNomes,-} lCPU]
	menu' <- get (menu state)
	--lighting $= Disabled
	desenhaMenu menu' state
	--lighting $= Enabled

desenhaMenu :: GLint -> State -> IO ()
desenhaMenu menu state
	| menu == 1 = do
					depthFunc $= Nothing
					preservingMatrix $ do
						currentColor $= Color4 0.5 0.5 0.5 0.5
						renderPrimitive Quads 
							$mapM_ (\(x, y, z)->vertex$Vertex3 x y z) losPontos
						renderPrimitive Quads 
							$mapM_ (\(x, y, z)->vertex$Vertex3 x (-y) z) losPontos
						currentColor $= Color4 1 1 1 1
						escreve (-55) 40 "SiMiAr - Simulador de MicroArquitetura"
						escreve 30 40 "Jose Ricardo Mello Viana"
						mpc' <- get (mpc state)
						programa' <- get (programa state)
						escreve (-55) 38 "Instrucao corrente (ISA):"
						instrucao <- escreveInstrucao state
						escreve (-55) 36 (instrucao)
						escreve (-10) 38 "Pilha do programa:"
						escreve (-10) 36 (show programa')
						variaveis' <- get (variaveis state)
						escreve 20 38 "Pilha de operandos:"
						escreve 20 36 (show variaveis')
						instrDesc' <- get (instrDesc state)
						escreve (-55) (-37) ("MPC: " ++ show mpc' ++ 
											" -> " ++ instrDesc')
						veloc' <- get (veloc state)
						escreve 20 (-37) ("Clock: " ++ show (round (veloc')))
						ciclo' <- get (ciclo state)
						porc' <- get (porc state)
						clock (3.6*((1 - (realToFrac porc'))+(9 - (fromIntegral (mod (ciclo' + 5) 10)))))
						mar' <- get (mar state)
						mdr' <- get (mdr state)
						pc' <- get (pc state)
						mbr' <- get (mbr state)
						sp' <- get (sp state)
						lv' <- get (lv state)
						cpp' <- get (cpp state)
						tos' <- get (tos state)
						opc' <- get (opc state)
						h' <- get (h state)
						desl' <- get (desl state)
						ula' <- get (ula state)
						escreve (-55) (-39) ("Regs: ")
						escreve (-50) (-39) ("MAR: " ++ show mar')
						escreve (-40) (-39) ("PC: " ++ show pc')
						escreve (-30) (-39) ("SP: " ++ show sp')
						escreve (-20) (-39) ("CPP: " ++ show cpp')
						escreve (-10) (-39) ("OPC: " ++ show opc')
						escreve 0 (-39) ("Deslocador:" ++ show desl')
						escreve (-50) (-41) ("MDR: " ++ show mdr')
						escreve (-40) (-41) ("MBR: " ++ show mbr')
						escreve (-30) (-41) ("LV: " ++ show lv')
						escreve (-20) (-41) ("TOS: " ++ show tos')
						escreve (-10) (-41) ("H: " ++ show h')
						escreve 0 (-41) ("ULA: " ++ ula')
	| otherwise = return ()

escreveInstrucao :: State -> IO String
escreveInstrucao state = do
							isaInstr' <- get (isaInstr state)
							case isaInstr' of
								0 -> return ("Buscando proxima instrucao")
								1 -> return ("NOP")
								2 -> return ("IADD")
								3 -> return ("ISUB")
								4 -> return ("IAND")
								5 -> return ("IOR")
								6 -> return ("DUP")
								7 -> return ("POP")
								8 -> return ("SWAP")
								9 -> return ("BIPUSH")
								10 -> return ("ILOAD")
								11 -> return ("ISTORE")
								12 -> return ("WIDE")
								13 -> return ("WIDE_ILOAD")
								14 -> return ("WIDE_ISTORE")
								15 -> return ("LDC_W")
								16 -> return ("IINC")
								17 -> return ("GOTO")
								18 -> return ("IFLT")
								19 -> return ("IFEQ")
								20 -> return ("IF_ICMPEQ")
								21 -> return ("T")
								22 -> return ("F")
								23 -> return ("INVOKEVIRTUAL")
								24 -> return ("IRETURN")
								_ -> return ("Ainda nao")
							

losPontos :: [(GLfloat,GLfloat,GLfloat)]
losPontos =[((-70), 50, 0.0),(70, 50, 0.0)
			,(70, 35, 0.0),((-70), 35, 0.0)]

clock ::GLfloat -> IO ()
clock x = do
			renderPrimitive LineLoop $ do
				vertex (Vertex3 20 (-37.5) (0::GLfloat))
				vertex (Vertex3 56 (-37.5) (0::GLfloat))
				vertex (Vertex3 56 (-41.5) (0::GLfloat))
				vertex (Vertex3 20 (-41.5) (0::GLfloat))
			renderPrimitive Points $ do
				reta (calc x 20) 18 (-41)
			renderPrimitive LineStrip $ do
				vertex (Vertex3 (calc x 38) (-41) (0::GLfloat))
				vertex (Vertex3 (calc x 38) (-38) (0::GLfloat))
			renderPrimitive Points $ do
				reta (calc x 38) 7.2 (-38)
			renderPrimitive LineStrip $ do
				vertex (Vertex3 (calc x 45.2) (-38) (0::GLfloat))
				vertex (Vertex3 (calc x 45.2) (-41) (0::GLfloat))
			renderPrimitive Points $ do
				reta (calc x 45.2) 10.8 (-41)

reta :: GLfloat -> GLfloat -> GLfloat -> IO ()
reta ini tam alt 
	| tam <= 0 = return ()
	| otherwise = do
					vertex (Vertex3 ini alt (0::GLfloat))
					reta (calc ini 0.08) (tam - 0.08) alt

calc :: GLfloat -> GLfloat -> GLfloat
calc x y = if ((x + y) > 56) then x + y - 36 else x + y

escreve :: GLfloat -> GLfloat -> String -> IO ()
escreve x y nome = preservingMatrix $ do
					currentColor $= Color4 0 0 0 1
					translate (Vector3 x y 0:: Vector3 GLfloat)
					preservingMatrix $ do
						scale 0.01 0.01 (0.01::GLfloat)
						renderString MonoRoman nome					
					currentColor $= Color4 1 1 1 1
					translate (Vector3 (-0.2) 0.2 0:: Vector3 GLfloat)
					preservingMatrix $ do
						scale 0.01 0.01 (0.01::GLfloat)
						renderString MonoRoman nome

reshape :: ReshapeCallback
reshape size@(Size w h) = do	
   	viewport $= (Position 0 0, size)
   	matrixMode $= Projection   	
   	loadIdentity
   	perspective 50 (fromIntegral w / fromIntegral h) 10 300
  	lookAt (Vertex3 0 0 90) (Vertex3 0 0 0) (Vector3 0 1 0)
	matrixMode $= Modelview 0
	loadIdentity

motion :: State -> MotionCallback
motion state (Position x y) = do
	x' <- get (eixox state)
	y' <- get (eixoy state)	
	botao' <- get (botao state)
	coordx' <- get (coordx state)
	coordy' <- get (coordy state)
	--putStr ("atual: " ++ show x ++ ", " ++ show y ++ ", " ++ show x' ++ ", " ++ 
		--show y' ++ "; outro: " ++ show coordx' ++ ", " ++ show coordy')
	--putStrLn ("x: " ++ show (x - coordx') ++ ", y: " ++ show (y - coordy'))
	--putStrLn ("x: " ++ show (x) ++ ", y: " ++ show (y))
	--putStrLn ("x': " ++ show (coordx') ++ ", y': " ++ show (coordy'))
	case botao' of
		0 -> putStrLn " : 0"
		1 -> do
			eixoy state $~ ((`mod` 360) . (+ (div (x - coordx') 50)))
			eixox state $~ ((`mod` 360) . (+ (div (y - coordy') 50)))
			postRedisplay Nothing
		2 -> putStrLn " : 2"
		3 -> putStrLn " : 3"

keyboard :: State -> KeyboardMouseCallback
keyboard state (MouseButton button) Down _ (Position x y) = case button of
	LeftButton   -> atribui 1
	MiddleButton -> atribui 2
	RightButton  -> atribui 3
	where
		atribui bt = do
						botao state $= bt
						coordx state $= x
						coordy state $= y

keyboard state (MouseButton button) Up _ _ = case button of
	_ -> botao state $= 0

keyboard state key Down _ _ = case key of
	(Char 'x')		-> update eixox 5
	(Char 'X')		-> update eixox (-5)
	(Char 'y')		-> update eixoy 5
	(Char 'Y')		-> update eixoy (-5)
	(Char 'Z')		-> update eixoz 5
	(Char 'z')		-> update eixoz (-5)
	(Char 'q')		-> volta
	(Char 'e')		-> roda
	(Char '>')		-> aumenta z2 1
	(Char '<')		-> aumenta z2 (-1)
	(Char '.')		-> aumenta z2 1
	(Char ',')		-> aumenta z2 (-1)
	SpecialKey KeyUp		-> aumenta y2 1
	SpecialKey KeyDown		-> aumenta y2 (-1)
	SpecialKey KeyLeft		-> aumenta x2 (-1)
	SpecialKey KeyRight		-> aumenta x2 1
	(Char 'p')		-> muda para
	(Char 'm')		-> muda menu
	(Char '+')		-> acelera
	(Char '-')		-> desacelera
	(Char '\27') 	-> saida
	_     	-> return ()
	where
		aumenta campo valor = do
			campo state $~ (+ valor)
			postRedisplay Nothing
		aumentaX campo valor = do
			campo' <- get (campo state)
			if ((campo' + valor) <= 0) then campo state $= 1
				else campo state $~ (+ valor)
			postRedisplay Nothing
		update joint inc = do
			joint state $~ ((`mod` 360) . (+ inc))
			postRedisplay Nothing
		acelera = do
			veloc' <- get (veloc state)
			if (veloc' >= 0.5) then
			  return()
			 else
			  veloc state $~ (+ 0.01)
		desacelera = do
			veloc' <- get (veloc state)
			if (veloc' <= 0.01) then
			  return()
			 else
			  veloc state $~ (+ (-0.01))
		roda = do
			eixox state $~ (+ 90)
		muda campo = do
			campo' <- get (campo state)
			campo state $= 1 - campo'
		volta = do
			eixox state $= 25
			eixoy state $= 0
			eixoz state $= 0
			x2 state $= 10
			y2 state $= (-2)
			z2 state $= (-20)
			postRedisplay Nothing
		saida = do
			aparece' <- get (aparece state)
			if (aparece' == 1) then
				exitWith ExitSuccess
			 else
				aparece state $= 1
keyboard _ _ _ _ _ = return ()

idle :: State -> IdleCallback
idle state = do
	aparece' <- get (aparece state)
	if (aparece' == 1) then do
		para' <- get (para state)
		if (para' == 0) then do		
		 	porc' <- get (porc state)
			veloc' <- get (veloc state)
			if (porc' >= 1) then do				
					porc state $= 0
					enchem' <- get (enchem state)
					cheios' <- get (cheios state)
					cheios state $= enchem' ++ cheios'
					ciclo state $~ ((`mod` 10) . (+ 1))
					ciclo' <- get (ciclo state)
					passaCiclo ciclo' state
				else porc state $~ (+ veloc')
			else
				return ()
		else do
			tamUFPI' <- get (tamUFPI state)
			if (tamUFPI' < 270) then 
			  tamUFPI state $~ (+ 1)
			 else do
			 	corI' <- get (corI state)
				textoI' <-  get (textoI state)
				if (corI' < 1) then do
				  if (textoI' == 1) then do
				  	proporcao state $~ (+ 0.175)
				  	escala state $~ (+ (- 0.0035))
				  	corI state $~ (+ 0.005)
				   else corI state $~ (+ 0.05)
				 else do
				  corI state $= 0
				  textoI state $~ (+ 1)				  
	postRedisplay Nothing

visible :: State -> Visibility -> IO ()
visible state Visible    = idleCallback $= Just (idle state)
visible _     NotVisible = idleCallback $= Nothing

main :: IO ()
main = do	
	(progName, _args) <- getArgsAndInitialize
	initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
	initialWindowSize $= Size 800 600
	initialWindowPosition $= Position 100 0
	createWindow "SiMiAr 2.0 - Simulador de MicroArquitetura"
	state <- makeState _args	
	myInit 
	displayCallback $= display state
	--fullScreen
	reshapeCallback $= Just reshape 
	keyboardMouseCallback $= Just (keyboard state)
	motionCallback $= Just (motion state)
	visibilityCallback $= Just (visible state)
	mainLoop